BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Prog/N-P/PaintToolUnit.cpt/PTDemo.Pas

Pascal/Delphi Source File | 1988-10-31 | 6.9 KB | 287 lines | [TEXT/TPAS]

Program PTDemo;

{$U-}
{$R PTDemoRes}
{$U PaintToolUnit}

Uses
  MemTypes,QuickDraw,OSIntf,ToolIntf,PackIntf,
  PaintToolUnit;

Const
  AppleMenu     = 128;
  FileMenu      = 129;
  EditMenu      = 130;
  ToolMenu      = 131;
  PatternMenu   = 132;
  PenSizeMenu   = 133;

Var
  myMenus       : array [AppleMenu..PenSizeMenu] of MenuHandle;
  SprayCurs     : CursHandle;
  CrossCurs     : CursHandle;
  theWindow     : WindowPtr;
  GrowArea      : Rect;
  CurrentTool   : Integer;
  CurrentPat    : Integer;
  CurrentSize   : Integer;

{###############################################################################}

Procedure ProcessMenu(codeWord : Longint);    { handle menu selections}
Var
  menuNum   : Integer;
  itemNum   : Integer;
  theStr    : Str255;
  dummy     : Integer;
Begin
  if codeWord <> 0 then begin
    menuNum := HiWord(codeWord);
    itemNum := LoWord(codeWord);
    case menuNum of { the different menus}
      AppleMenu :
        begin
          if itemNum = 1 then {DoAbout}
          else begin
            GetItem(myMenus[AppleMenu],itemNum,theStr);
            dummy:= OpenDeskAcc(theStr);
          end;
        end;
      FileMenu : ExitToShell;
      EditMenu : if NOT SystemEdit(itemNum - 1) then ;
      ToolMenu :
        begin
          CheckItem(myMenus[ToolMenu],CurrentTool,false);
          CurrentTool:= itemNum;
          CheckItem(myMenus[ToolMenu],CurrentTool,true);
        end;
      PatternMenu :
        begin
          CheckItem(myMenus[PatternMenu],CurrentPat,false);
          CurrentPat:= itemNum;
          CheckItem(myMenus[PatternMenu],CurrentPat,true);
          SetPort(theWindow);
          case CurrentPat of
            1 : PenPat(white);
            2 : PenPat(ltGray);
            3 : PenPat(gray);
            4 : PenPat(dkGray);
            5 : PenPat(black);
          end
        end;
      PenSizeMenu :
        begin
          CheckItem(myMenus[PenSizeMenu],CurrentSize,false);
          CurrentSize:= itemNum;
          CheckItem(myMenus[PenSizeMenu],CurrentSize,true);
          SetPort(theWindow);
          case CurrentSize of
            1 : PenSize(1,1);
            2 : PenSize(2,2);
            3 : PenSize(2,4);
            4 : PenSize(4,2);
            5 : PenSize(5,5);
            6 : PenSize(10,2);
            7 : PenSize(2,10);
            8 : PenSize(10,10);
          end
        end;
    end; {case}
    HiliteMenu(0);
  end; {big if}
End;

{###############################################################################}

Procedure DealWithMouseDowns(theEvent: EventRecord);
Var
  whichWindow   : WindowPtr;
  mouseLoc      : Point;
  windowLoc     : Integer;
  position      : LongInt;
  dummy         : Integer;
Begin
  mouseLoc:= theEvent.where;
  windowLoc:= FindWindow(mouseLoc,whichWindow);
  case windowLoc of
    inMenuBar   : ProcessMenu(MenuSelect(mouseLoc));
    inSysWindow : SystemClick(theEvent,whichWindow);
    inDrag      : DragWindow(whichWindow,mouseLoc,screenBits.bounds);
    inZoomIn,inZoomOut :
      begin
        if TrackBox(whichWindow,mouseLoc,windowLoc) then begin
          SetPort(whichWindow);
          ClipRect(whichWindow^.portRect);
          EraseRect(whichWindow^.portRect);
          ZoomWindow(whichWindow,windowLoc,true);
          InvalRect(whichWindow^.portRect);
        end;
      end;
    inGrow :
      begin
        position:= GrowWindow(whichWindow,mouseLoc,GrowArea);
        if position <> 0 then begin
          SizeWindow(whichWindow,loword(position),hiword(position),false);
          SetPort(whichWindow);
          InvalRect(whichWindow^.portRect);
        end;
      end;
    inGoAway :
      begin
        if TrackGoAway(whichWindow,mouseLoc) then ExitToShell;
      end;
    inContent :
      begin
        if whichWindow <> FrontWindow then
          SelectWindow(whichWindow)
        else begin
          SetPort(whichWindow);
          GlobalToLocal(mouseLoc);
          DoPaintTools(CurrentTool,mouseLoc,theEvent.modifiers);
          if PTError = TUnImp then
            dummy:= Alert(128,nil)
          else if PTError <> noErr then sysbeep(1);
        end;
      end;
  end;
End;

Procedure DealWithKeyDowns(theEvent: EventRecord);
Var
  CharCode  : char;
Begin
  CharCode := CHR(BitAnd(theEvent.message,charCodeMask));
  if BitAnd(theEvent.modifiers,CmdKey) = CmdKey
    then ProcessMenu(MenuKey(CharCode));
End;

Procedure DealWithActivates(theEvent: EventRecord);
Var
  TargetWindow    : WindowPtr;
Begin
  TargetWindow := WindowPtr(theEvent.message);
  if Odd(theEvent.modifiers)
    then SetPort(TargetWindow);
End;

Procedure DealWithUpdates(theEvent: EventRecord);
Var
  UpDateWindow  : WindowPtr;
  tempPort      : WindowPtr;
Begin
  UpDateWindow := WindowPtr(theEvent.message);
  GetPort(tempPort);
  SetPort(UpDateWindow);
  BeginUpDate(UpDateWindow);
    ClipRect(UpDateWindow^.portRect);
    EraseRect(UpDateWindow^.portRect);
    PenSize(5,5);
    FrameOval(UpDateWindow^.portRect);
    PenSize(1,1);
  EndUpDate(UpDateWindow);
  SetPort(tempPort);
End;

Procedure AdjustCursor;
Var
  where : Point;
Begin
  GetMouse(where);
  if (theWindow = FrontWindow) AND PtInRect(where,theWindow^.portRect) then
    case CurrentTool of
      TSpray    : SetCursor(SprayCurs^^);
      TLine     : SetCursor(CrossCurs^^);
    end
  else
    InitCursor;
End;

Procedure MainEventLoop;
Var
  Event        : EventRecord;
Begin
  repeat
    AdjustCursor;
    SystemTask;
    if GetNextEvent(everyEvent, Event) then
      case Event.what of
        mouseDown   : DealWithMouseDowns(Event);
        AutoKey     : DealWithKeyDowns(Event);
        KeyDown     : DealWithKeyDowns(Event);
        ActivateEvt : DealWithActivates(Event);
        UpdateEvt   : DealWithUpdates(Event);
      end; {case}
  until FALSE;
End;

{###############################################################################}

Procedure SetupMacintosh;
Var
  theWatch  : CursHandle;
Begin
  MaxApplZone;
  MoreMasters;
  MoreMasters;
  MoreMasters;

  FlushEvents(everyEvent,0);

  InitGraf(@thePort);
  InitFonts;
  InitWindows;
  InitMenus;
  TEInit;
  InitDialogs(nil);

  theWatch:= GetCursor(watchCursor);
  SetCursor(theWatch^^);
End;

Procedure SetupMenus;
Var
  index    : Integer;
Begin
  for index:= AppleMenu to PenSizeMenu do begin
    myMenus[index] := GetMenu(index);
    InsertMenu(myMenus[index],0);
  end;
  AddResMenu(myMenus[AppleMenu],'DRVR');
  DrawMenuBar;
End;

Procedure SetupStuff;
Var
  tempRect  : Rect;
  version   : Integer;
Begin
  version:= InitPaintTools;

  with screenBits.bounds do
    SetRect(GrowArea,200,200,right,bottom);

  SetRect(tempRect,50,50,400,300);
  theWindow:= NewWindow(nil,tempRect,'untitled',true,8,pointer(-1),true,0);
  SetPort(theWindow);

  CurrentTool:= TPencil;
  CurrentPat:= 5;
  CurrentSize:= 1;
  CheckItem(myMenus[ToolMenu],CurrentTool,true);
  CheckItem(myMenus[PatternMenu],CurrentPat,true);
  CheckItem(myMenus[PenSizeMenu],CurrentSize,true);

  SprayCurs:= GetCursor(128);
  CrossCurs:= GetCursor(crossCursor);
End;

Begin
  SetupMacintosh;

  SetupMenus;
  SetupStuff;
  InitCursor;

  MainEventLoop;
End.